home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 2 / Tech Arsenal 2 (Arsenal Computer).iso / dbase / itcom1.exe / COMPARE.EXE / IT / DEMO / TEST2.CLA < prev   
Encoding:
Text File  |  1993-10-05  |  10.7 KB  |  276 lines
  1.                 TITLE('TEST1')
  2. OMIT('╝')
  3. ╔════════════════════════════════════════════════════════════════════════════╗
  4. ║  Program - TEST1                               !                           ║
  5. ║  Author  - Jane Doe                            !                           ║
  6. ╚════════════════════════════════════════════════════════════════════════════╝
  7.                  PROGRAM
  8.  
  9.                  INCLUDE('KEYCODES.EQU')
  10.                  INCLUDE('CLARION.EQU')
  11.                  INCLUDE('ERRORS.EQU')
  12.  
  13.                  MAP
  14.                    CheckOpen(*FILE)
  15.                    DiskError(<STRING>),BYTE
  16.                    ShowWarning
  17.                    MODULE('ITCOMP01')
  18.                      Procedure110
  19.                      Procedure122
  20.                      Procedure133
  21.                    END
  22.                    MODULE('ITCOMP02')
  23.                      Procedure213
  24.                      Procedure223
  25.                      Procedure234
  26.                    END
  27.                    MODULE('ITCOMP03')
  28.                      Procedure315
  29.                      Function327(STRING,QUEUE,BYTE),SHORT
  30.                      Procedure337
  31.                      Procedure348
  32.                    END
  33.                    MODULE('ITCOMP04')
  34.                      Function491(FILE,FILE),SHORT
  35.                      Function423(FILE,FILE),SHORT
  36.                    END
  37.                    INCLUDE('C:\CLARION3\INCLUDE.INC')
  38.                    INCLUDE('GETDIR.INC')
  39.  EMBED('~~::PROGRAM~1~MAP Structure~1~~')
  40.                    INCLUDE('TEMPFILE.INC')
  41.  
  42.  ENDEMBED
  43.  
  44.                  END
  45.  
  46.                  EJECT('File Layouts')
  47.  
  48. GLO:MessageGroup GROUP
  49. GLO:Message1       STRING(45)
  50. GLO:Message2       STRING(45)
  51. GLO:Message3       STRING(45)
  52.                  .
  53. GLO:InsertMsg    STRING('Record will be added {9}')
  54. GLO:ChangeMsg    STRING('Record will be changed {7}')
  55. GLO:DeleteMsg    STRING('Select OK to delete {10}')
  56. GLO:Filespec     STRING(64)
  57. dF:Variable1     STRING(64)
  58. dF:Variable2     STRING(64)
  59. dF:Variable3     STRING(64)
  60. df:Variable4     STRING(64)
  61. dF:Variable5     STRING(64)
  62. dF:Variable6     STRING(64)
  63. dF:Variable7     STRING(64)
  64. ExitChain        SHORT
  65. GLO:EnablePrint  BYTE
  66. ! ███████████████████████████████████████████████████████████████████
  67. !  TEST2.CLA
  68. ! ███████████████████████████████████████████████████████████████████
  69.  
  70. FileIn           FILE,PRE(In),DRIVER('BASIC'),NAME(dF:AsciiIn) !<<DRIVER
  71. STRUCT             RECORD                                      !<<STRUCT
  72. sLine                STRING(255)
  73.                  . .
  74.  
  75.  
  76.  
  77. File1            FILE,PRE(FiL),DRIVER('Btrieve'),NAME(dF:Variable1) !<<PRE
  78. I_Dyna1            INDEX(),NAME('Dyna.idx')                    !<<<NAME
  79. I_Dyna2            INDEX(+Fi1:Field1,-Fi1:Field2),NOCASE,OPT   !<<NOCASE
  80. K_Dummy            KEY(+Fi1:Field1,+Fi1:Field2,-Fi1:Field3),DUP!<<Order 2nd
  81. testrecord         RECORD
  82. Field1               STRING(64)
  83. Field2               STRING(8)                             !<<STRING(8)
  84. Field3               LONG
  85. Field4               STRING(8)
  86. Field5               STRING(32)
  87. Field6               STRING(12)
  88. Field7               BYTE                                  !<<Commented
  89. Field8               BYTE
  90. Field9               BYTE
  91. Field10              STRING(64)
  92. Field11              STRING(3)
  93.                  . .
  94.  
  95. File2            FILE,PRE(Fi2),DRIVER('Clarion')      !<<No CREATE, No Name
  96. I_Dyna1            INDEX(),NOCASE
  97. I_Dyna2            INDEX(),NOCASE
  98. RECORD             RECORD
  99. Field1               STRING(16)                       !<<STRING(16)
  100. Field2               STRING(16)
  101. Field3               LONG
  102. Field4               STRING(8)
  103. Field5               STRING(16)
  104. !Field6              STRING(12)                       !<<Commented
  105. Field7               BYTE
  106. Field8               BYTE
  107. Field9               BYTE
  108. Field10              STRING(64)
  109. Field11              STRING(3)
  110.                  . .
  111.  
  112. !  File3 is OMITted from TEST1.CLA
  113. File3            FILE,PRE(Fi3),DRIVER('Clarion'),CREATE,NAME('Fields1.dat')
  114. I_Dyna1            INDEX(),NOCASE
  115. I_Dyna2            INDEX(),NOCASE
  116. RECORD             RECORD
  117. Field31              LONG
  118. Field32              LONG
  119. Field33              LONG
  120. Field34              STRING(16)
  121. Field35              STRING(20)
  122.                  . .
  123.  
  124. File4            FILE,PRE(Fi4),DRIVER('Clarion'),CREATE,NAME(dF:Variable4)!─┐
  125. I_Dyna1            INDEX(),NOCASE               !<<DRIVER, no NAME ──────────┘
  126. I_Dyna2            INDEX(),NOCASE
  127. RECORD             RECORD
  128. Field41              LONG
  129. Field42              LONG
  130. Field43              LONG
  131. Field44              STRING(16)
  132. Field45              STRING(20)
  133. Group41              Group,Pre(G44)                    !<<PRE
  134. GrField41                    STRING(4)
  135. GrField42                    BYTE                      !<<LONG
  136.                  . . .
  137.  
  138. File5            FILE,PRE(Fi5),DRIVER('Clarion'),CREATE,NAME(dF:Variable5)
  139. I_Dyna1            INDEX(),NOCASE
  140. I_Dyna2            INDEX(),NOCASE
  141. RECORD             RECORD
  142. Field51              LONG
  143. Field52              LONG
  144. Field53              LONG
  145. Field54              STRING(16)
  146. Field55              STRING(16)
  147. Field56              SHORT
  148. Field57              STRING(16)
  149. Field58              BYTE
  150. Group59              Group,Pre(G59)                    !No GROUP Group59
  151. GrField591                   STRING(4)
  152. GrField592                   BYTE
  153.                  . . .
  154. !<<< NO File6
  155.  
  156.  
  157. AddRecord        EQUATE(1)                       !  Add a new record
  158. ChangeRecord     EQUATE(2)                       !  Change the current record
  159. DeleteRecord     EQUATE(3)                       !  Delete the current record
  160.  
  161.  EMBED('~~::PROGRAM~1~Data Section~1~~')
  162. QSetting           Queue,Pre(Qst)
  163. CodeType             BYTE
  164. SetValue             STRING(32)
  165.                    .
  166.  
  167. n                  LONG
  168. nFormat            STRING(5)
  169. Temp               CSTRING(65)
  170. TmpFile            CSTRING(65)
  171.  ENDEMBED
  172.  
  173.  
  174.   CODE
  175.     Procedure1
  176.   RETURN                                         !Return to DOS
  177.  
  178. OMIT('╝')
  179. ╔════════════════════════════════════════════════════════════════════════════╗
  180. ║  Check ERROR() function after opening a file                               ║
  181. ╚════════════════════════════════════════════════════════════════════════════╝
  182. CheckOpen         PROCEDURE(File)
  183.  
  184.   CODE
  185.   OPEN(File,22h)                                 !Attempt to open the file
  186.   CASE ERRORCODE()                               ! and check for errors
  187.   OF NoError                                     !Return if no error
  188.   OROF IsOpenErr                                 ! or if already open.
  189.     RETURN
  190.   OF NoFileErr                                   !If file was not found
  191.     CREATE(File)                                 !Create the file
  192.     OPEN(File,22h)                               ! then open it
  193.     IF ~ERRORCODE() THEN RETURN.                 !  And return if it opened
  194.   OF InvalidFileErr                              !Invalid Record Declaration
  195.     GLO:Message1 = 'Error accessing: '& NAME(File)
  196.     GLO:Message2 = 'Code: ' & ERRORCODE() & ' ' & ERROR()
  197.     GLO:Message3 = 'Press OK to return to DOS'
  198.     ShowWarning
  199.     HALT(InvalidFileErr)
  200.   OF BadKeyErr                                   !Key Files must be rebuilt
  201.     GLO:Message1 = NAME(File) & ' Key file is invalid'
  202.     GLO:Message3 = 'Press OK to rebuild keyfile'
  203.     ShowWarning
  204.     OPEN(File,12H)                               !Open for exclusive access
  205.     BUILD(File)                                  !Rebuild the key files
  206.     IF ERRORCODE()
  207.       GLO:Message1 = NAME(File) & ' The file cannot be repaired'
  208.       GLO:Message2 = 'while other stations are using it'
  209.       GLO:Message3 = 'Press OK to return to DOS'
  210.       ShowWarning
  211.       HALT(BadKeyErr)
  212.     ELSE
  213.       CLOSE(File)                                !Close
  214.       OPEN(File,22h)                             ! then open it
  215.     END
  216.   END                                            !End of Case Structure
  217.   IF DiskError(NAME(File) & ' File could not be opened') THEN HALT(0). !Cannot resume
  218.  
  219. OMIT('╝')
  220. ╔════════════════════════════════════════════════════════════════════════════╗
  221. ║  Check ERROR() function after a disk access                                ║
  222. ╚════════════════════════════════════════════════════════════════════════════╝
  223. DiskError        FUNCTION(Cause)
  224. StopMsg::        STRING(180)
  225.  
  226.   CODE
  227.   IF ~ERRORCODE() THEN RETURN(0).                !Return with no error
  228.   IF ~OMITTED(1)                                 !If a cause was given
  229.     StopMsg:: = 'Cause: ' & Cause & LF:CR        !  Display it
  230.   END                                            !End IF
  231.   IF ERRORFILE()                                 !If error involves a file
  232.     StopMsg:: = CLIP(StopMsg::) & 'File : '  |   !  display the file
  233.               & ERRORFILE() & LF:CR
  234.   END                                            !End IF
  235.   StopMsg:: = CLIP(StopMsg::) & 'Error: '    |   !Display the error code
  236.             & ERRORCODE() & ' - '            |   !  and the error message
  237.             & ERROR() & LF:CR
  238.  
  239.   STOP(StopMsg::)                                !Stop with message
  240.   RETURN(1)                                      !Return with error
  241.  
  242. OMIT('╝')
  243. ╔════════════════════════════════════════════════════════════════════════════╗
  244. ║  Display a warning message using 3 Global message variables.               ║
  245. ╚════════════════════════════════════════════════════════════════════════════╝
  246. ShowWarning      PROCEDURE
  247.  
  248. SaveStyle        STRING(256)
  249.  
  250. Screen           SCREEN(9,53),PRE(SCR),CENTER,SHADOW,CUA,COLOR(112)
  251.                    ROW(1,1)    STRING('█▀{51}█'),COLOR(116)
  252.                    ROW(9,1)    STRING('█▄{51}█'),COLOR(116)
  253.                                REPEAT(7)
  254.                    ROW(2,1)      STRING('█'),COLOR(116)
  255.                    ROW(2,53)     STRING('█'),COLOR(116)
  256.                                .
  257.                    ROW(3,5)    ENTRY(@S45),USE(GLO:Message1),INS,SKIP,COLOR(112,112,112)
  258.                    ROW(4,5)    ENTRY(@S45),USE(GLO:Message2),INS,SKIP,COLOR(112,112,112)
  259.                    ROW(5,5)    ENTRY(@s45),USE(GLO:Message3),INS,SKIP,COLOR(112,112,112)
  260.                    ROW(7,24)   BUTTON('  &Ok  |'),SHADOW,USE(?Ok),COLOR(23,71,24,31,79)
  261.                  .
  262.  
  263.   CODE
  264.   SaveStyle = STYLES()                           !Save current style
  265.   GETSTYLES('')                                  !Turn off Styles
  266.   GLO:Message1 = CENTER(GLO:Message1,SIZE(GLO:Message1))
  267.   GLO:Message2 = CENTER(GLO:Message2,SIZE(GLO:Message2))
  268.   GLO:Message3 = CENTER(GLO:Message3,SIZE(GLO:Message3))
  269.   OPEN(Screen)
  270.   DISPLAY
  271.   ACCEPT                                         !Enable keyboard and mouse
  272.   CLEAR(GLO:MessageGroup)                        !Blank out message fields
  273.   SETSTYLES(SaveStyle)                           !Restore user styles
  274.   RETURN
  275.  
  276.